package clbonding;

use warnings;

BEGIN {
	use cld_client;
	use Digest::MD5;
	use Data::Dumper;
	use Sys::Hostname;
	use File::Basename;
	use XML::Simple;
	use Exporter ();
	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);

	$VERSION=0.6;
	@ISA	= qw(Exporter);
	@EXPORT	= qw(&bonding_check_params &bonding_get_defaults &bonding_create
			&bonding_get_interfaces &bonding_destroy &bonding_get_info);
	@EXPORT_OK = qw();
}
our @EXPORT_OK;

#########################################################################
# First function is passed a string and will return (0,"OK" or "1",err,	#
# err) if errors exist in the param:value [param:value...] string	#
# for the bonding support.						#
#########################################################################

sub bonding_check_params {
my %values=(	"miimon"	=> ["i","0-1000","Value in milliseconds - between 0 and 1000."],
		"mode"		=> ["s","0,1,5,6","Link mode - should be 0, 1, 5 or 6."],
		"use_carrier"	=> ["i","0,1","Use netif_carrier_ok calls - should be 0 or 1."]
	   );
my $str=$_[0];
my @errs=();
my ($cvar,$cval);
my ($ok,$cel);

if(!defined($str)) {
	return (0,"OK");
}

	for (split(/\s+/,$str)) {
		if(! /([a-z_\-]+):([a-z0-9_\-]+)$/) {
			push @errs,"$_ is not in valid format.";
		} else {
			if(!exists($values{$1})) {
				push @errs,"Parameter $1 is not currently supported or is unknown.";
				next;
			}
			($cvar,$cval)=($1,$2);
			my ($type,$range,$errstr)=@{$values{$1}}[0..2];
			if($type eq "i") {
				if($cval !~ /^[0-9]+$/) {
					push @errs,"$cvar : $errstr";
					next;
				}
				if($range =~ /^([0-9]+)-([0-9]+)$/) {
					my ($st,$fi)=($1,$2);
					if($cval >= $st && $cval <= $fi) {
						next;
					}
					push @errs,"$cvar - $cval : $errstr";
					next;
				}
				$ok=0;
				for $cel (split(/,/,$range)) {
					$ok=1 if $cel == $cval; 
				}
				push @errs,"$cvar - $cval : $errstr" if ! $ok;
				next;
			} else {
				$ok=0;
				foreach $cel (split(/,/,$range)) {
					$ok=1 if $cel eq $cval;
				}
				push @errs,"$cvar - $cval : $errstr" if ! $ok;
				next;
			}
		}
	}
	if(!scalar(@errs)) {
		return (0,"OK");
	}
	return (1,@errs);
}

#########################################################################
# Return the default parameters to use.					#
#########################################################################

sub bonding_get_defaults {
	return "mode:1 miimon:100";
}

#########################################################################
# Create a new bonding device, given the following keys in a hash	#
# passed to the routine:						#
# APPLICATION		The name of the application to create a bond	#
#			for - used to indicate the name given to the	#
#			loaded module.					#
# INTERFACES		Comma separated list of interfaces to use for	#
#			the bonding device, (must be two).		#
# FLAGS			attribute:value list of attributes to apply	#
#			to the bonded device.				#
# IP			The IP address to assign to the interface.	#
# NETMASK		The network mask to apply to the interface.	#
#									#
# This will create a new bonding device, reloading the module if	#
# required. The name of the bonded device will be part of the		#
# return code.								#
# Return values are:							#
# ("OK","bondN") - the device created.					#
# ("ERROR","err msg") - unable to create bond device.			#
#									#
# Note: A lock from the cldaemon should be achevied first to ensure	#
# no other application attempts the same operation at the same time.	#
#########################################################################

sub bonding_create {
my %args=@_;
my ($fd,$cline,%devinfo,%routeinfo,%ipaddrs,%mods,@F,$ip);
my ($count,$cint,$cint2,$app,$myip,$bargs);

	if(! -x "/sbin/ifenslave") {
		return("ERROR","/sbin/ifenslave utility can not be found!");
	}

	if(!exists($args{APPLICATION}) || !exists($args{IP}) || !exists($args{FLAGS})
			|| !exists($args{INTERFACES})) {
		return("ERROR","Missing mandatory argument to create_bond function.");
	}

	$app=$args{APPLICATION};
	$myip=$args{IP};
	$bargs=$args{FLAGS};

	$bargs =~ s/:/=/g;
	%devinfo=();
	%routeinfo=();
	%ipaddrs=();
	%mods=();
	#################################################################
	# Load in details on the list of devices...			#
	#################################################################
	if(!open($fd,"/proc/net/dev")) {
		return("ERROR","Unable to open /proc/net/dev");
	}
	while($cline=<$fd>) {
		chomp $cline;
		if($cline !~ /^\s+[a-z0-0]+:/) {
			@F=split(/\s+/,$cline);
			$devinfo{$F[1]}=$cline;
		}
	}
	close($fd);

	#################################################################
	# Load in those with actual routes.				#
	#################################################################

	if(!open($fd,"/proc/net/route")) {
		return("ERROR","Unable to open /proc/net/route");
	}
	$cline=<$fd>;
	while($cline=<$fd>) {
		chomp $cline;
		@F=split(/\s+/,$cline);
		$routeinfo{$F[0].":"}=$cline;
	}
	close($fd);

	#################################################################
	# Check that the interfaces we want to use exist...		#
	#################################################################

	$count=0;
	foreach $cint (split(/,/,$args{INTERFACES})) {
		if(!exists($devinfo{$cint.":"})) {
			return("ERROR","Interface device $cint does not exist.");
		}
		if(exists($routeinfo{$cint.":"})) {
			return("ERROR","Interface device $cint already has routes!");
		}
		$count++;
	}
	if($count!=2) {
		return("ERROR","Two interfaces must be specified.");
	}

	#################################################################
	# If the specified interface exists, then we need to check to	#
	# see if the specified IP address exists.			#
	#################################################################

	if(!open($fd,"/sbin/ifconfig|")) {
		return("ERROR","Unable to run ifconfig command.");
	}
	while($cline=<$fd>) {
		if($cline =~ /^[a-z]+/) {
			chomp $cline;
			@F=split(/\s+/,$cline);
			$cline=<$fd>;
			($ip)=($cline =~ /inet addr:([0-9\.]+)/);
			$ipaddrs{$F[0]}=$ip;
		}
	}
	close($fd);

	#################################################################
	# Scan any/all bonding interfaces, to see if one is already	#
	# loaded, and if so we down it first, and then unload the	#
	# module...							#
	#################################################################

	if(!open($fd,"/proc/modules")) {
		return("ERROR","Unable to open /proc/modules");
	}
	while($cline=<$fd>) {
		chomp $cline;
		@F=split(/\s+/,$cline);
		$mods{$F[0]}=$cline;
	}
	close($fd);
	if(exists($mods{"cldbond_$app"})) {
		for $cint (grep {/^bond/} (keys %ipaddrs)) {
			if($ipaddrs{$cint} eq $myip) {
				$r=`/sbin/ifconfig $cint down 2>/dev/null`;
				last;
			}
		}
		$r=`/sbin/rmmod cldbond_$app 2>&1 >/dev/null`;
		chomp $r;
		if($r ne "") {
			return("ERROR","Unable to unload module: $r");
		}
	}

	#################################################################
	# Work out where the interface will be loaded!!			#
	#################################################################
	my @blist=grep {/^bond/} (keys %ipaddrs);
	$cint=0;
	while(scalar(grep {/^bond$cint$/} @blist)) {
		$cint++;
	}
	$cint="bond$cint";

	#################################################################
	# If the module was loaded, it is no longer!!			#
	# So now we actually load it again, with the required		#
	# arguments and name.						#
	#################################################################

	if(defined(&::runcmd)) {
		$r=::runcmd("/sbin/insmod -o cldbond_$app bonding $bargs 2>&1 >/dev/null");
	} else {
		$r=`/sbin/insmod -o cldbond_$app bonding $bargs 2>&1 >/dev/null`;
	}
	chomp $r;
	if($r ne "") {
		return("ERROR","Unable to insert bonding module as cldbond_$app");
	}

	#################################################################
	# Module has been inserted, so now set up the slave interfaces	#
	# and then the netmask and IP address.				#
	#################################################################

	my $cmd;
	$cmd="/sbin/ifconfig $cint inet $myip";
	$cmd.=" netmask ".$args{NETMASK} if exists($args{NETMASK});
	if(defined(&::runcmd)) {
		$r=::runcmd("$cmd 2>&1 >/dev/null");
	} else {
		$r=`$cmd 2>&1 >/dev/null`;
	}
	chomp $r;
	if($r ne "") {
		return("ERROR","Unable to initialise interface $cint");
	}

	#################################################################
	# Now the interfaces are slaved to it...			#
	#################################################################

	foreach $cint2 (split(/,/,$args{INTERFACES})) {
		if(defined(&::runcmd)) {
			$r=::runcmd("/sbin/ifconfig $cint2 down 2>&1 >/dev/null");
			$r=::runcmd("/sbin/ifenslave $cint $cint2 2>&1 >/dev/null");
		} else {
			$r=`/sbin/ifconfig $cint2 down 2>&1 >/dev/null`;
			$r=`/sbin/ifenslave $cint $cint2 2>&1 >/dev/null`;
		}
		chomp $r;
		if($r ne "") {
			return("ERROR","Unable to ifenslave interface $cint2 to $cint");
		}
	}

	$cmd="/sbin/ifconfig $cint up";
	if(defined(&::runcmd)) {
		$r=::runcmd("$cmd 2>&1 >/dev/null");
	} else {
		$r=`$cmd 2>&1 >/dev/null`;
	}
	chomp $r;
	if($r ne "") {
		return("ERROR","Unable to up interface $cint");
	}
	#################################################################
	# Ok - everyhing is finished!					#
	#################################################################

	return("OK",$cint);
}

#########################################################################
# The following routine is passed a series of interface names an	#
# returns the first two that currently do not have any routes		#
# associated with them. These are then returned as a list. If no	#
# such interfaces are available then an empty list is returned. If 	#
# only a single interface is available a single element list is		#
# returned.								#
# The interfaces are passed as a scalar comma separated.		#
#########################################################################

sub bonding_get_interfaces {
my @clist=split(/,/,$_[0]);
my ($cint,$fd,$cline,@F,%routeinfo);
my @ok=();

	%routeinfo=();

	#################################################################
	# Load in those with actual routes.				#
	#################################################################

	if(!open($fd,"/proc/net/route")) {
		return("ERROR","Unable to open /proc/net/route");
	}
	$cline=<$fd>;
	while($cline=<$fd>) {
		chomp $cline;
		@F=split(/\s+/,$cline);
		$routeinfo{$F[0]}=$cline;
	}
	close($fd);

	for $cint (@clist) {
		if(!scalar(grep {/^$cint$/} (keys %routeinfo))) {
			push @ok,$cint;
		}
	}
	if(scalar(@ok)>=2) {
		return (@ok[0..1]);
	}
	if(scalar(@ok)) {
		return ($ok[0]);
	}
	return ();
}

#########################################################################
# Below is a routine that removes the IP address for an application	#
# from a bonded network device, downing the interfaces and removing	#
# IP addresses from them.						#
# It makes use of the /proc/net/bondN/info file to work out which 	#
# interfaces belong to a particular bonded device.			#
# Arguments are specified as a hash:					#
# APPLICATION	: The name of the application.				#
# IP	   	: The IP address to remove.				#
# Return value is ("ERROR","message") or ("OK","Interface")		#
#########################################################################

sub bonding_destroy {
my %args=@_;
my ($fd,$cline,@F,$cint);
my $found=undef;

	if(!exists($args{APPLICATION}) || !exists($args{IP})) {
		return("ERROR","Missing mandatory argument");
	}
	if(!open($fd,"/sbin/ifconfig -a|")) {
		return("ERROR","Unable to run ifconfig command");
	}
	$cint=undef;
	while($cline=<$fd>) {
		if($cline =~ /^bond[0-9]/) {
			@F=split(/\s+/,$cline);
			$cint=$F[0];
		} elsif($cline =~ /^[a-z]+/) {
			$cint=undef;
		}
		if(defined($cint) && $cline =~ /inet addr:([0-9\.]+)\s+/) {
			$cip=$1;
			if($cip eq $args{IP}) {
				$found=$cint;
				last;
			}
		}
	}
	close($fd);
	if(!defined($found)) {
		return("ERROR","Interface with that IP address not found!");
	}

	#################################################################
	# We now have the interface, so we need to parse the file	#
	# /proc/net/<interface>/info to find out which two ethernet	#
	# cards were part of the device so we can remove the IP		#
	# address and down the interfaces...				#
	#################################################################

	if(!open($fd,"/proc/net/$found/info")) {
		return("ERROR","Unable to open file /proc/net/$found/info");
	}
	my @ilist=();
	while($cline=<$fd>) {
		chomp $cline;
		if($cline =~ /^Slave Interface:/) {
			@F=split(/\s+/,$cline);
			push @ilist,$F[2];
		}
	}
	close($fd);

	#################################################################
	# We now down the bonded interface and set the IP addresses	#
	# of the slaves to 0.0.0.0					#
	#################################################################

	my ($r,$cmd);

	$cmd="/sbin/ifconfig $found down 2>&1 >/dev/null";
	if(defined(&::runcmd)) {
		$r=::runcmd($cmd);
	} else {
		$r=`$cmd`;
	}
	chomp $r;
	if($r ne "" && defined(&::warnmsg)) {
		::warnmsg("$cmd returned:");
		::warnmsg("$r");
	}

	#################################################################
	# Take down each of the slave interfaces, and then we can	#
	# remove the module if possible.				#
	#################################################################

	foreach (@ilist) {
		$cmd="/sbin/ifconfig $_ inet 0.0.0.0 down 2>&1 >/dev/null";
		if(defined(&::runcmd)) {
			$r=::runcmd($cmd);
		} else {
			$r=`$cmd`;
		}
		chomp $r;
		if($r ne "" && defined(&::warnmsg)) {
			::warnmsg("$cmd returned:");
			::warnmsg("$r");
		}
	}

	$cmd="/sbin/rmmod cldbond_".$args{APPLICATION}." 2>&1 >/dev/null";
	if(defined(&::runcmd)) {
		$r=::runcmd($cmd);
	} else {
		$r=`$cmd`;
	}
	chomp $r;
	if($r ne "" && defined(&::warnmsg)) {
		::warnmsg("$cmd returned:");
		::warnmsg("$r");
	}
	return("OK",$found);
}

sub bonding_get_info {
my %args=@_;
my ($fd,$cline,@F,$i);
my ($mode,$active,$int1,$int2,$f1,$f2);

	return("ERROR","Missing INTERFACE argument") if !exists($args{INTERFACE});
	$i=$args{INTERFACE};
	if(! -f "/proc/net/$i/info") {
		return("ERROR","Unable to find file /proc/net/$i/info");
	}
	if(!open($fd,"/proc/net/$i/info")) {
		return("ERROR","Unable to open file /proc/net/$i/info");
	}
	while($cline=<$fd>) {
		chomp $cline;

		if($cline =~ /^Bonding Mode: (.*)$/) {
			$mode=$1;
		}
		if($cline =~ /^Currently Active Slave: (.*)$/) {
			$active=$1;
		}
		if($cline =~ /^Slave Interface: (.*)$/) {
			if(!defined($int1)) {
				$int1=$1;
			} else {
				$int2=$1;
			}
		}
		if($cline =~ /^Link Failure Count: (.*)$/) {
			if(!defined($int2)) {
				$f1=$1;
			} else {
				$f2=$1;
			}
		}
	}
	close($fd);

	print "here!\n";
	# Now the information has been retrieved we need return the	#
	# information in the required format.				#

	return ($mode,defined($active) ? $active : "Unknown", 
			defined($int1) ? $int1 : "Unknown",
			defined($f1) ? $f1 : "Unknown",
			defined($int2) ? $int2 : "Unknown",
			defined($f2) ? $f2 : "Unknown"
	       );
}

1;

